#lang sicp
(define (make-table)
  (define (make-table data-set) (cons 'table data-set))
  (define (empty-table? t) (empty-data-set? (cdr t)))
  (define (set-table-data-set! table data-set)
    (set-cdr! table data-set))
  (define (data-set-table t) (cdr t))

  (define (make-data-set) '())
  (define (empty-data-set? d) (null? d))
  (define (insert-data-set set data)
    (cons data set))
  (define (find-data-set data-set key)
    (cond ((empty-data-set? data-set) #f)
          ((equal? key (key-data (car data-set))) (car data-set))
          (else
           (find-data-set (cdr data-set) key))))

         
  (define (make-data key record sub-table)
    (list key record sub-table))
  (define (key-data data) (car data))
  (define (record-data data) (cadr data))
  (define (sub-table-data data) (caddr data))
  (define (set-record-data! new-value data)
    (set-car! (cdr data) new-value))

  (define (last-keys? keys) (null? (cdr keys)))
  (define (create-data keys content)
    (define (iter keys)
      (if (last-keys? keys)
          (make-data (car keys) content (make-table (make-data-set)))
          (let ((data (iter (cdr keys)))
                (data-set (make-data-set)))
            (make-data (car keys) nil (make-table (insert-data-set data-set data))))))
    (iter keys))
  
  (define (put keys content table)
    (define (iter keys t)
      (if (empty-table? t)
          (let ((data-set (make-data-set))
                (data (create-data keys content)))
            (set-table-data-set! t (insert-data-set data-set data)))
          (let ((key (car keys))
                (data-set (data-set-table t)))
            (let ((data (find-data-set data-set key)))
              (if data
                  (if (last-keys? keys)
                      (set-record-data! content data)
                      (iter (cdr keys) (sub-table-data data)))
                  (let ((data (create-data keys content)))
                    (set-table-data-set! t (insert-data-set data-set data))))))))
    (iter keys table))

  (define (get keys table)
    (let ((key (car keys))
          (data-set (data-set-table table)))
      (if (empty-data-set? data-set)
          #f
          (let ((data (find-data-set data-set key)))
            (if data
                (if (last-keys? keys)
                    data
                    (get (cdr keys) (sub-table-data data)))
                #f)))))

  
  (let ((table (make-table nil)))
    (define (dispatch m)
      (cond ((eq? m 'put)
             (lambda (op types proc)
               (put (list op types) proc table)))
            ((eq? m 'get)
             (lambda (op types)
               (let ((data (get (list op types) table)))
                 (if data
                     (record-data data)
                     #F))))
            (else
             (error "unknowed operation -- MAKE-TABLE" m))))
    dispatch))

;; main
(define arithmetic-table (make-table))
(define get (arithmetic-table 'get))
(define put (arithmetic-table 'put))


(define coercion-table (make-table))
(define get-coercion (coercion-table 'get))
(define put-coercion (coercion-table 'put))


(define (get-type x)
  (if (number? x)
      'number
      (car x)))
(define (get-contents x)
  (if (number? x)
      x
      (cdr x)))
(define (attach-type type x) (cons type x))
(define (square x) (* x x))


(define (apply-generic op . args)
  (let ((types (map get-type args))
        (contents (map get-contents args)))
    (let ((proc (get op types)))
      (if proc
          (apply proc contents)
          (if (= (length types) 2)
              (let ((t1 (car types))
                    (t2 (cadr types)))
                (if (eq? t1 t2)
                    (error "No method for these types" (list op args))
                    (let ((t1->t2 (get-coercion t1 t2))
                          (t2->t1 (get-coercion t2 t1))
                          (a1 (car args))
                          (a2 (cadr args)))
                      (cond (t1->t2
                             (apply-generic op (t1->t2 a1) a2))
                            (t2->t1
                             (apply-generic op a1 (t2->t1 a2)))
                            (else
                             (error "No method for these types" (list op args)))))))
              (error "No method for these types" (list op args)))))))



;;generic arithmetic operation
(define (add a b)
  (apply-generic 'add a b))
(define (sub a b)
  (apply-generic 'sub a b))
(define (mul a b)
  (apply-generic 'mul a b))
(define (div a b)
  (apply-generic 'div a b))
(define (equ? a b)
  (apply-generic 'equ? a b))
(define (=zero? a) (apply-generic '=zero? a))
(define (exp b e) (apply-generic 'exp b e))


(define (make-from-real-imag r i)
  ((get 'make-from-real-imag 'complex) r i))
(define (make-from-mag-ang m a)
  ((get 'make-from-mag-ang 'complex) m a))
(define (make-rational numer denom)
  ((get 'make-rational 'rational) numer denom))


(define (real-part x)
  (apply-generic 'real-part x))
(define (imag-part x)
  (apply-generic 'imag-part x))
(define (magnitude x)
  (apply-generic 'magnitude x))
(define (angle x)
  (apply-generic 'angle x))

(put 'real-part '(complex) real-part)
(put 'imag-part '(complex) imag-part)
(put 'magnitude '(complex) magnitude)
(put 'angle '(complex) angle)

;; complex
(define (install-complex-arithmetic-package)
  (define (add-complex z1 z2)
    (make-from-real-imag (+ (real-part z1) (real-part z2))
                         (+ (imag-part z1) (imag-part z2))))
  (define (sub-complex z1 z2)
    (make-from-real-imag (- (real-part z1) (real-part z2))
                         (- (imag-part z1) (imag-part z2))))
  (define (mul-complex z1 z2)
    (make-from-mag-ang (* (magnitude z1) (magnitude z2))
                       (+ (angle z1) (angle z2))))
  (define (div-complex z1 z2)
    (make-from-mag-ang (/ (magnitude z1) (magnitude z2))
                       (- (angle z1) (angle z2))))
  (define (equ-complex? z1 z2)
    (and (= (real-part z1) (real-part z2))
         (= (imag-part z1) (imag-part z2))))
  (define (=zero? z)
    (and (= (real-part z) 0) (= (imag-part z) 0)))
  
  
  (define (make-from-mag-ang m a)
    (attach-type 'polar ((get 'make-from-mag-ang '(polar)) m a)))
  (define (make-from-real-imag m a)
    (attach-type 'rectangular ((get 'make-from-real-imag '(rectangular)) m a)))


  ;; install sub package
  (define (install-complex-polar)
    (define (real-part z) (* (magnitude z) (cos (angle z))))
    (define (imag-part z) (* (magnitude z) (sin (angle z))))
    (define (magnitude z) (car z))
    (define (angle z) (cdr z))
    (define (make-from-real-imag x y)
      (cons (sqrt (+ (square x) (square y)))
            (atan y x)))
    (define (make-from-mag-ang r a) (cons r a))

    ;; install
    (define type 'polar)
    (define set (lambda (op type proc)
                  (put op (list type) proc)))
    (set 'real-part type real-part)
    (set 'imag-part type imag-part)
    (set 'magnitude type magnitude)
    (set 'angle type angle)
    (set 'make-from-real-imag type make-from-real-imag)
    (set 'make-from-mag-ang type make-from-mag-ang)
    'done--install-complex-polar)

  (define (install-complex-rectangular)
    (define (real-part z) (car z))
    (define (imag-part z) (cdr z))
    (define (magnitude z)
      (sqrt (+ (square (real-part z))
               (square (imag-part z)))))
    (define (angle z)
      (atan (imag-part z) (real-part z)))
    (define (make-from-real-imag x y) (cons x y))
    (define (make-from-mag-ang r a)
      (cons (* r (cos a)) (* r (sin a))))

    ;;install
    (define type 'rectangular)
    (define set (lambda (op type proc)
                  (put op (list type) proc)))
    (set 'real-part type real-part)
    (set 'imag-part type imag-part)
    (set 'magnitude type magnitude)
    (set 'angle type angle)
    (set 'make-from-real-imag type make-from-real-imag)
    (set 'make-from-mag-ang type make-from-mag-ang)
    'done--install-complex-rectangular)
  (install-complex-rectangular)
  (install-complex-polar)

  
  (define (tag content) (attach-type 'complex content))
  (put 'add '(complex complex)
       (lambda (x y) (tag (add-complex x y))))
  (put 'sub '(complex complex)
       (lambda (x y) (tag (sub-complex x y))))
  (put 'mul '(complex complex)
       (lambda (x y) (tag (mul-complex x y))))
  (put 'div '(complex complex)
       (lambda (x y) (tag (div-complex x y))))
  (put 'make-from-real-imag 'complex
       (lambda (r i)
         (tag (make-from-real-imag r i))))
  (put 'make-from-mag-ang 'complex
       (lambda (m a)
         (tag (make-from-mag-ang m a))))
  (put 'equ? '(complex complex) equ-complex?)
  (put '=zero? '(complex) =zero?)
  'done--install-complex-arithmetic-package
)

(install-complex-arithmetic-package)





;; install common number arithmetic
(define (install-number-arithmetic-package)
  (put 'add '(number number) +)
  (put 'sub '(number number) -)
  (put 'div '(number number) /)
  (put 'mul '(number number) *)
  (put 'equ? '(number number) =)
  (put '=zero? '(number) (lambda (x) (= x 0)))
  (put 'exp '(number number) expt)
  'done-install-number-arithmetic-package)

(install-number-arithmetic-package)


;; install rational arithmetic
(define (install-rational-arithmetic-package)
  (define (add-rat x y)
    (make-rat (+ (* (numer x) (denom y))
                 (* (numer y) (denom x)))
              (* (denom x) (denom y))))
  (define (sub-rat x y)
    (make-rat (- (* (numer x) (denom y))
                 (* (numer y) (denom x)))
              (* (denom x) (denom y))))
  (define (mul-rat x y)
    (make-rat (* (numer x) (numer y))
              (* (denom x) (denom y))))
  (define (div-rat x y)
    (make-rat (* (numer x) (denom y))
              (* (denom x) (numer y))))
  (define (equa-rat? x y)
    (= (* (numer x) (denom y))
       (* (numer y) (denom x))))
  (define (=zero? x)
    (= (numer x) 0))
  
  (define (make-rat n d)
    (let ((g (gcd n d)))
      (cons (/ n g) (/ d g))))
  (define (numer x) (car x))
  (define (denom x) (cdr x))

  ;; install
  (define (tag x) (attach-type 'rational x))
  (put 'add '(rational rational)
       (lambda (x y) (tag (add-rat x y))))
  (put 'sub '(rational rational)
       (lambda (x y) (tag (sub-rat x y))))
  (put 'mul '(rational rational)
       (lambda (x y) (tag (mul-rat x y))))
  (put 'div '(rational rational)
       (lambda (x y) (tag (div-rat x y))))
  (put 'make-rational 'rational
       (lambda (numer denom)
         (tag (make-rat numer denom))))
  (put 'equ? '(rational rational) equa-rat?)
  (put '=zero? '(rational) =zero?)
  'done-install-rational-arithmetic-package)

(install-rational-arithmetic-package)




;; install coercion
(put-coercion 'number 'complex
              (lambda (n)
                (make-from-real-imag n 0)))
(put-coercion 'number 'rational
              (lambda (n)
                (make-rational n 1)))


;; test
(define a 2)
(define b 4)
(define c-a (make-from-real-imag 3 4))
(define c-b (make-from-mag-ang 5 0.729))
(define c-c (make-from-real-imag 0 0))
(define c-d (make-from-mag-ang 0 0.91))
(define r-a (make-rational 1 2))
(define r-b (make-rational 3 4))
(define r-c (make-rational 0 2))


(add a r-a)
(mul a r-a)
(add a c-a)
(sub a c-a)
